home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
gsdb25.zip
/
GS_PICK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-01
|
7KB
|
224 lines
UNIT GS_Pick;
INTERFACE
USES
Crt,
Dos,
GS_Scrn,
GS_Error,
GS_KeyI,
GS_Sort,
GS_Strng,
GS_Winfc;
function GS_Pick_Row_Item (var tabl; clth : integer;
icnt, sitem : longint): longint;
function GS_Pick_Line_Item (var tabl; clth : integer;
icnt, sitem : longint) : longint;
procedure GS_Pick_Item_Sort (var tabl; clth : integer;
icnt : longint; ascnd : boolean);
{tabl = starting location of the array}
{clth = length of entry (for a string, it is length(string)+1 to include the}
{ length byte. Recommend passing sizeof(entry) for accuracy)}
{icnt = number of entries}
{ascnd = boolean value for sort direction. True for ascending sort; false for
descending.
{sitem = entry number to highlight. Can be any number form 1 to icnt. This}
{ can be used to "remember" the last item selected. for example: }
{ }
{ i := 1; }
{ while i <> 0 do }
{ begin }
{ i := GS_Pick_Line_Item(dataarray,sizeof(dataentry),25,i); }
{ case i of }
{ . }
{ . }
{ . }
{ end; }
{ end; }
implementation
var
Sort_Tab : GS_Sort_Objt;
txc,
bgc,
fgc,
txh,
bgh : byte;
procedure FindColors;
begin
GS_Wind_GetColors(txc,bgc,fgc,txh,bgh);
end;
function GS_Pick_Row_Item (var tabl; clth : integer;
icnt, sitem : longint): longint;
var
ci, cw, ct, l : longint;
cj, cis,
cih : longint;
lins,
wdth, fl,
x, y, k : integer;
chrr : char;
strng : string[255];
z : array [0..maxint-1] of char absolute tabl;
begin
GS_KeyI_Fuc := false;
GS_Scrn_HideCursor;
FindColors;
lins := (hi(windmax)) - (hi(windmin));
wdth := ((lo(windmax)) - (lo(windmin))) + 1;
l := icnt;
ci := sitem div lins;
ci := ci * lins;
fl := sitem;
cih := 0;
cis := 1;
repeat
if ci + (lins-1) > l then ci := l - (lins-1);
if ci < 1 then ci := 1;
if (not GS_KeyI_Fuc) and (fl <= icnt) then cis := (fl - ci)+1;
cj := ci;
if ci <> cih then
begin
k := 1;
cih := ci;
while cj < ci+lins do
begin
if cj <= l then
begin
y := k;
x := 2;
gotoxy(x,y);
move(z[((cj-1)*(clth))],strng[0],clth);
fillchar(strng[length(strng)+1],clth-length(strng),' ');
strng[0] := chr(clth);
write(strng);
inc(cj);
inc(k);
end else cj := 9999;
end;
gotoxy(1,lins+1);
if cj-1 < l then write('':(wdth-10) div 2,'-- more --')
else write('':wdth-1);
end;
GS_Scrn_Put_Atr(1,cis,wdth,cis,txh,bgh);
chrr := GS_KeyI_GetKey;
GS_Scrn_Put_Atr(1,cis,wdth,cis,txc,bgc);
if GS_KeyI_Fuc then
begin
case chrr of
Kbd_Home : begin
ci := 1;
cis := 1;
end;
Kbd_End : begin
ci := l;
cis := lins;
end;
Kbd_PgUp : begin
ci := ci - lins;
end;
Kbd_PgDn : begin
ci := ci + lins;
end;
Kbd_UpAr : begin
if cis = 1 then ci := ci - 1 else cis := cis - 1;
end;
Kbd_DnAr : begin
if cis = lins then ci := ci + 1 else cis := cis + 1;
end;
else SoundBell(BeepTime, BeepFreq);
end;
if cis > l then cis := l;
end else
begin
case chrr of
Kbd_Ret : GS_Pick_Row_Item := ci+cis-1;
Kbd_Esc : GS_Pick_Row_Item := 0;
else
begin
fl := 1;
while (z[((fl-1)*(clth))+1] <> chrr) and
(z[((fl-1)*(clth))+1] <> upcase(chrr)) and
(fl <= icnt) do inc(fl);
if fl <= icnt then ci := fl
else SoundBell(BeepTime, BeepFreq);
end;
end;
end;
until chrr in [Kbd_Ret,Kbd_Esc];
GS_Scrn_ShowCursor;
end;
function GS_Pick_Line_Item (var tabl; clth : integer;
icnt, sitem : longint) : longint;
var
ci,
x, y, k, l : integer;
chrr : char;
strng : string[255];
z : array [0..maxint-1] of char absolute tabl;
begin
GS_Scrn_HideCursor;
FindColors;
l := icnt;
y := 1;
ci := succ(pred(sitem)*clth);
if ci > l*clth then ci := ((l-1)*clth)+1;
if ci < 1 then ci := 1;
repeat
k := 1;
while k <= l do
begin
x := ((k-1) * clth)+1;
gotoxy(x,y);
move(z[((k-1)*(clth))],strng[0],clth);
if length(strng) > pred(clth) then
ShowError(851,'Error in GS_Pick_Line_Item Length');
fillchar(strng[length(strng)+1],clth-length(strng),' ');
strng[0] := chr(pred(clth));
write(strng);
inc(k);
end;
GS_Scrn_Put_Atr(ci,y,ci+clth-1,y,txh,bgh);
chrr := GS_KeyI_GetKey;
GS_Scrn_Put_Atr(ci,y,ci+clth-1,y,txc,bgc);
if GS_KeyI_Fuc then
begin
case chrr of
Kbd_Home : ci := 1;
Kbd_LfAr : ci := ci - clth;
Kbd_RtAr : ci := ci + clth;
Kbd_End : ci := ((l-1) * clth) + 1;
end;
if ci > l*clth then ci := 1;
if ci < 1 then ci := ((l-1)*clth)+1;
end;
until chrr in [Kbd_Ret,Kbd_Esc];
if chrr = Kbd_Ret then
begin
GS_Pick_Line_Item := (ci div clth) + 1 ;
end else GS_Pick_Line_Item := 0;
GS_Scrn_ShowCursor;
end;
procedure GS_Pick_Item_Sort (var tabl; clth : integer;
icnt : longint; ascnd : boolean);
begin
if icnt > 1 then
begin
Sort_Tab.SortDir(ascnd);
Sort_Tab.Sort(tabl,clth,icnt);
end;
end;
begin
Sort_Tab.InitSort(true); {Init ascending sort object)}
end.